home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_pr4.lha / st80_pre4 / MoDE / Windowing-Shan.st < prev   
Text File  |  1993-07-24  |  20KB  |  853 lines
  1. TextLabel subclass: #ShrunkenWText
  2.     instanceVariableNames: 'window '
  3.     classVariableNames: ''
  4.     poolDictionaries: ''
  5.     category: 'Windowing-Shan'!
  6.  
  7.  
  8. !ShrunkenWText methodsFor: 'private'!
  9.  
  10. window: aWindow 
  11.     "Shan June 15, 1989"
  12.  
  13.     window _ aWindow.
  14.     self text: aWindow title! !
  15. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  16.  
  17. ShrunkenWText class
  18.     instanceVariableNames: ''!
  19.  
  20.  
  21. !ShrunkenWText class methodsFor: 'instance creation'!
  22.  
  23. window: aWindow
  24.     ^self new window: aWindow! !
  25.  
  26. SemanticObject subclass: #TitleBar
  27.     instanceVariableNames: 'window title '
  28.     classVariableNames: ''
  29.     poolDictionaries: ''
  30.     category: 'Windowing-Shan'!
  31.  
  32.  
  33. !TitleBar methodsFor: 'attach'!
  34.  
  35. attachTo: aWindow 
  36.     "Attach the title bar to aWindow (semObj).  Assuming the window's extent has 
  37.     been instantiated.  Shan May 11, 1989"
  38.  
  39.     aWindow mode addSubMode: mode at: 0 @ 0.
  40.     mode window: (mode window width: aWindow mode window width).
  41.     target1 _ aWindow! !
  42.  
  43. !TitleBar methodsFor: 'title'!
  44.  
  45. title: s 
  46.     | dispObj dispText|
  47.     title _ s.
  48.     dispObj _ mode displayObject.
  49.     dispText _ s asDisplayText.
  50.     dispText align: dispText boundingBox center with: dispObj boundingBox center.
  51.     dispObj clear.  "Shan January 2, 1990"
  52.     dispObj absAdd: dispText! !
  53.  
  54. !TitleBar methodsFor: 'controller-msg'!
  55.  
  56. moveWindow: e 
  57.     "Follow the cursor to move the window. Ask the window semObj to 
  58.     do it. Shan June 4, 1989"
  59.  
  60.     "target1 mode moveToFront."
  61.     mode controller highlight.
  62.     "To support the SNATextWindow. When the user click on the titlebar 
  63.     to bring the window to top, also highlight the bar. Shan 16 May 
  64.     1990"
  65.     target1 move!
  66.  
  67. rename: e 
  68.     "Shan 1 June 1990"
  69.  
  70.     | titleString |
  71.     self eventQueue disable.
  72.     titleString := FillInTheBlank request: 'New title' initialAnswer: ''.
  73.     self eventQueue enable.
  74.     titleString = '' ifTrue: [^nil].
  75.     target1 title: titleString.!
  76.  
  77. toFront: e 
  78.     "Shan 25 May 1990"
  79.  
  80.     target1 mode obscuringRects size > 0 ifTrue: [target1 mode toFront]! !
  81.  
  82. !TitleBar methodsFor: 'MMS-initializations'!
  83.  
  84. setUpAppearance
  85.     "Shan June 6, 1989"
  86.  
  87.     | dispObj |
  88.     super setUpAppearance.
  89.     mode extent: 200@28.  "Shan July 21, 1989"
  90.     dispObj _ mode displayObject.
  91.     dispObj borderWidth: 2.
  92.     mode scaledBackground.
  93.     dispObj insideColor: Form lightGray.
  94.     "Shan July 21, 1989"
  95.     mode highlightDispObj: (dispObj copy insideColor: Form darkGray)!
  96.  
  97. setUpController
  98.     "Shan June 6, 1989"
  99.  
  100.     | ctrl erDict |
  101.     ctrl _ OpaqueController1 new.
  102.     erDict _ ctrl eventResponses deepCopy.
  103.     erDict at: #leftButtonDown put: #moveWindow:.
  104.     erDict at: #leftButtonUp put: #toFront:.
  105.     erDict at: #middleButtonDoubleClick put: #rename:. "Shan 1 June 1990"
  106.     ctrl eventResponses: erDict.
  107.     mode controller: ctrl!
  108.  
  109. setUpMode
  110.     "Shan June 9, 1989"
  111.  
  112.     | rs |
  113.     super setUpMode.
  114.     rs _ ResizeStyle new.
  115.     rs originX: #fixed.
  116.     rs originY: #fixed.
  117.     rs extentY: #fixed.
  118.     rs cornerX: #fixed.
  119.     mode resizeStyle: rs! !
  120. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  121.  
  122. TitleBar class
  123.     instanceVariableNames: ''!
  124.  
  125.  
  126. !TitleBar class methodsFor: 'instance creation'!
  127.  
  128. title: s 
  129.     "Shan June 6, 1989"
  130.  
  131.     ^self new title: s! !
  132.  
  133. TitleBar subclass: #MacTitleBar
  134.     instanceVariableNames: ''
  135.     classVariableNames: ''
  136.     poolDictionaries: ''
  137.     category: 'Windowing-Shan'!
  138.  
  139.  
  140. !MacTitleBar methodsFor: 'MMS-initializations'!
  141.  
  142. setUpAppearance
  143.     "Shan June 6, 1989"
  144.  
  145.     | dispObj line hDispObj |
  146.     super setUpAppearance.
  147.     dispObj _ mode displayObject.
  148.     dispObj borderWidth: 2.
  149.     dispObj insideColor: Form white.
  150.     mode highlightDispObj: dispObj deepCopy.
  151.     hDispObj _ mode highlightDispObj.
  152.     "This must be done after the extent and the borderWidth have been 
  153.     set. No for the bWidth now.  Shan December 1, 1989"
  154.     mode scaledBackground.
  155.     line _ MMSLine
  156.                 from: 0 @ 5
  157.                 to: 200 @ 5
  158.                 width: 1
  159.                 color: Form black.
  160.     hDispObj relAdd: line.
  161.     line _ MMSLine
  162.                 from: 0 @ 8
  163.                 to: 200 @ 8
  164.                 width: 1
  165.                 color: Form black.
  166.     hDispObj relAdd: line.
  167.     line _ MMSLine
  168.                 from: 0 @ 11
  169.                 to: 200 @ 11
  170.                 width: 1
  171.                 color: Form black.
  172.     hDispObj relAdd: line.
  173.     line _ MMSLine
  174.                 from: 0 @ 14
  175.                 to: 200 @ 14
  176.                 width: 1
  177.                 color: Form black.
  178.     hDispObj relAdd: line.
  179.     line _ MMSLine
  180.                 from: 0 @ 17
  181.                 to: 200 @ 17
  182.                 width: 1
  183.                 color: Form black.
  184.     hDispObj relAdd: line.
  185.     hDispObj makeFaster! !
  186.  
  187. TitleBar subclass: #ShadedTitleBar
  188.     instanceVariableNames: ''
  189.     classVariableNames: ''
  190.     poolDictionaries: ''
  191.     category: 'Windowing-Shan'!
  192.  
  193.  
  194. !ShadedTitleBar methodsFor: 'title'!
  195.  
  196. title: s
  197.     "Shan 10 May 1990"
  198.  
  199.     super title: s.
  200.     "Draw the shadows."
  201.     self setUpAppearance.! !
  202.  
  203. !ShadedTitleBar methodsFor: 'MMS-initializations'!
  204.  
  205. setUpAppearance
  206.     "Shan September 5, 1989"
  207.  
  208.     | dispObj line |
  209.     super setUpAppearance.
  210.     mode extent: 400@28.
  211.     dispObj _ mode displayObject.
  212.     dispObj borderWidth: 2.
  213.     "This must be done after the extent and the borderWidth have been 
  214.     set. "
  215.     mode scaledBackground.
  216.     dispObj insideColor: Form lightGray.
  217.     line _ MMSLine
  218.                 from: 2 @ 2
  219.                 to: 400 @ 2
  220.                 width: 2
  221.                 color: Form white.
  222.     dispObj absAdd: line.
  223.     line _ MMSLine
  224.                 from: 2 @ 25
  225.                 to: 400 @ 25
  226.                 width: 1
  227.                 color: Form black.
  228.     dispObj absAdd: line.
  229.     line _ MMSLine
  230.                 from: 2 @ 2
  231.                 to: 2 @ 28
  232.                 width: 2
  233.                 color: Form white.
  234.     dispObj absAdd: line.
  235.     line _ MMSLine
  236.                 from: 396 @ 3
  237.                 to: 396 @ 28
  238.                 width: 1
  239.                 color: Form black.
  240.     dispObj absAdd: line.
  241.     line _ MMSLine
  242.                 from: 397 @ 2
  243.                 to: 397 @ 28
  244.                 width: 1
  245.                 color: Form black.
  246.     dispObj absAdd: line.
  247.     dispObj makeFaster.
  248.     mode highlightDispObj: nil! !
  249.  
  250. SemanticObject subclass: #ShrunkenWindow
  251.     instanceVariableNames: 'window '
  252.     classVariableNames: ''
  253.     poolDictionaries: ''
  254.     category: 'Windowing-Shan'!
  255.  
  256.  
  257. !ShrunkenWindow methodsFor: 'MMS-initializations'!
  258.  
  259. defaultMMSControllerClass
  260.     "Shan August 24, 1989"
  261.  
  262.     ^MoveImageController1!
  263.  
  264. defaultModeClass
  265.     "Shan August 24, 1989"
  266.  
  267.     ^ModeGroup!
  268.  
  269. setUpController
  270.     "Shan August 24, 1989"
  271.  
  272.     | ctrl erDict |
  273.     super setUpController.
  274.     ctrl _ mode controller.
  275.     erDict _ ctrl eventResponses deepCopy.
  276.     erDict at: #leftButtonDoubleClick put: #expand:.
  277.     ctrl eventResponses: erDict! !
  278.  
  279. !ShrunkenWindow methodsFor: 'private'!
  280.  
  281. window: aWindow 
  282.     "Shan August 24, 1989"
  283.  
  284.     | pictureMode text |
  285.     window _ aWindow.
  286.     pictureMode _ FixedImageMode new.
  287.     pictureMode semanticObject: SemanticObject new.    "Shan 29 May 1990"
  288.     pictureMode imageForm: MMSOpaqueForm sheet.
  289.     text _ ShrunkenWText window: aWindow.
  290.     ModeGrouper parent: mode centerVerticalChildren: (OrderedCollection with: pictureMode with: text mode)! !
  291.  
  292. !ShrunkenWindow methodsFor: 'controller-msg'!
  293.  
  294. expand: e
  295.     "Tell the window to expand.  Shan August 24, 1989"
  296.  
  297.     Display zoom: mode unclippedDisplayBox to: window mode unclippedDisplayBox.
  298.     window mode moveToFront.
  299.     window mode mapAndDisplay! !
  300. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  301.  
  302. ShrunkenWindow class
  303.     instanceVariableNames: ''!
  304.  
  305.  
  306. !ShrunkenWindow class methodsFor: 'instance creation'!
  307.  
  308. window: aWindow
  309.     ^self new window: aWindow! !
  310.  
  311. SemanticObject subclass: #ControlBox
  312.     instanceVariableNames: ''
  313.     classVariableNames: ''
  314.     poolDictionaries: ''
  315.     category: 'Windowing-Shan'!
  316.  
  317.  
  318. !ControlBox methodsFor: 'MMS-initializations'!
  319.  
  320. setUpAppearance
  321.     "Shan July 21, 1989"  
  322.  
  323.     super setUpAppearance.
  324.     mode extent: 18@18! !
  325. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  326.  
  327. ControlBox class
  328.     instanceVariableNames: ''!
  329.  
  330.  
  331. !ControlBox class methodsFor: 'instance creation'!
  332.  
  333. client: aWindow 
  334.     "aWindow must be an instance of Window class.  Shan June 7, 1989"
  335.  
  336.     ^self new client: aWindow! !
  337.  
  338. ControlBox subclass: #ResizeBox
  339.     instanceVariableNames: ''
  340.     classVariableNames: ''
  341.     poolDictionaries: ''
  342.     category: 'Windowing-Shan'!
  343.  
  344.  
  345. !ResizeBox methodsFor: 'MMS-initializations'!
  346.  
  347. setUpAppearance
  348.     "Shan June 6, 1989"
  349.  
  350.     | dispObj |
  351.     super setUpAppearance.  "Shan July 21, 1989"
  352.     dispObj _ mode displayObject.
  353.     dispObj borderWidth: 2.
  354.     dispObj insideColor: Form white.
  355.     dispObj relAdd: (Quadrangle
  356.             region: (4 @ 4 extent: 8 @ 9)
  357.             borderWidth: 1
  358.             borderColor: Form black
  359.             insideColor: Form white).
  360.     dispObj relAdd: (Quadrangle
  361.             region: (2 @ 2 extent: 7 @ 7)
  362.             borderWidth: 1
  363.             borderColor: Form black
  364.             insideColor: Form white).
  365.     dispObj makeFaster!
  366.  
  367. setUpController
  368.     "Shan June 6, 1989"
  369.  
  370.     | ctrl erDict |
  371.     ctrl _ MController new.
  372.     erDict _ ctrl eventResponses deepCopy.
  373.     erDict at: #leftButtonDown put: #resize:.
  374.     ctrl eventResponses: erDict.
  375.     mode controller: ctrl!
  376.  
  377. setUpMode
  378.     "Shan June 9, 1989"
  379.  
  380.     | rs |
  381.     super setUpMode.
  382.     rs _ ResizeStyle new.
  383.     rs extentX: #fixed.
  384.     rs extentY: #fixed.
  385.     rs cornerX: #fixed.
  386.     rs cornerY: #fixed.
  387.     mode resizeStyle: rs! !
  388.  
  389. !ResizeBox methodsFor: 'controller-msg'!
  390.  
  391. resize: e 
  392.     "Resize the client.  See the implementation in MMSController1 for 
  393.     details. Shan June 8, 1989"
  394.  
  395.     | clientMode frame background event |
  396.     clientMode _ target1 mode.
  397.     target1 minimumSize = target1 maximumSize ifTrue: [^self].
  398.     clientMode controller
  399.             resize: #bottomRight
  400.             outline: [:frame :mousePoint | frame corner: ((mousePoint max: frame origin + target1 minimumSize)
  401.                         min: frame origin + target1 maximumSize)]
  402.             width: 2
  403.             halftone: Form gray.
  404.     target1 applicationMode changed: #contentsBoundingBoxMayBeChanged.! !
  405.  
  406. !ResizeBox methodsFor: 'private'!
  407.  
  408. client: aWindow 
  409.     "Shan 15 May 1990"
  410.  
  411.     target1 _ aWindow! !
  412.  
  413. ControlBox subclass: #ShrinkBox
  414.     instanceVariableNames: ''
  415.     classVariableNames: ''
  416.     poolDictionaries: ''
  417.     category: 'Windowing-Shan'!
  418.  
  419.  
  420. !ShrinkBox methodsFor: 'controller-msg'!
  421.  
  422. shrink: e
  423.     "Shrink the client into an icon.  Shan June 7, 1989"
  424.     target1 shrink! !
  425.  
  426. !ShrinkBox methodsFor: 'MMS-initializations'!
  427.  
  428. setUpAppearance
  429.     "Shan June 6, 1989"
  430.  
  431.     | dispObj |
  432.     super setUpAppearance.  "Shan July 21, 1989"
  433.     dispObj _ mode displayObject.
  434.     dispObj borderWidth: 2.
  435.     dispObj insideColor: Form white!
  436.  
  437. setUpController
  438.     "Shan June 6, 1989"
  439.  
  440.     | ctrl erDict |
  441.     ctrl _ MController new.
  442.     erDict _ ctrl eventResponses deepCopy.
  443.     erDict at: #leftButtonDown put: #shrink:.
  444.     ctrl eventResponses: erDict.
  445.     mode controller: ctrl! !
  446.  
  447. !ShrinkBox methodsFor: 'private'!
  448.  
  449. client: aWindow 
  450.     "Attach self to a window.  This includes add the mode of self as a 
  451.     subMode of the window mode and assign the window as the client of 
  452.     self.  Shan June 7, 1989"
  453.  
  454.     aWindow mode addSubMode: mode at: 5 @ 5.
  455.     target1 _ aWindow! !
  456.  
  457. SemanticObject subclass: #Trash
  458.     instanceVariableNames: ''
  459.     classVariableNames: ''
  460.     poolDictionaries: ''
  461.     category: 'Windowing-Shan'!
  462.  
  463.  
  464. !Trash methodsFor: 'MMS-initializations'!
  465.  
  466. defaultMMSControllerClass
  467.     "Shan July 21, 1989"
  468.  
  469.     ^MoveImageController1!
  470.  
  471. defaultModeClass
  472.     "Shan July 21, 1989"
  473.  
  474.     ^FixedImageMode!
  475.  
  476. setUpAppearance
  477.     "Shan July 21, 1989"
  478.  
  479.     | dispObj |
  480.     super setUpAppearance.  "Shan July 21, 1989"
  481.     dispObj _ mode displayObject.
  482.     dispObj absAdd: MMSOpaqueForm trash.
  483.     mode highlightDispObj: (MDisplayObject new borderWidth: 0; absAdd: MMSOpaqueForm openTrash).! !
  484.  
  485. !Trash methodsFor: 'drag support'!
  486.  
  487. deHighlightOnTop: e 
  488.     "Shan July 22, 1989"
  489.  
  490.     mode controller dragDeHighlightOnTop!
  491.  
  492. dragControllerFor: aSymbol 
  493.     "Shan July 21, 1989"
  494.  
  495.     | ctrl erDict |
  496.     aSymbol == #move
  497.         ifTrue: 
  498.             [ctrl _ MController new.
  499.             erDict _ ctrl eventResponses deepCopy.
  500.             erDict at: #leftButtonUp put: #trashIt:.
  501.             erDict at: #enterMode put: #highlightOnTop:.
  502.             erDict at: #leaveMode put: #deHighlightOnTop:.
  503.             ctrl eventResponses: erDict.
  504.             ^ctrl].
  505.     ^super dragControllerFor: aSymbol!
  506.  
  507. highlightOnTop: e 
  508.     "Shan July 22, 1989"
  509.  
  510.     mode controller dragHighlightOnTop!
  511.  
  512. trashIt: e
  513.     "Trash the dragged object.  Shan July 21, 1989"
  514.  
  515.     mode deHighlight! !
  516.  
  517. SemanticObject subclass: #Window
  518.     instanceVariableNames: 'shrunkenWindow applicationMode maximumSize minimumSize title titleBar '
  519.     classVariableNames: ''
  520.     poolDictionaries: ''
  521.     category: 'Windowing-Shan'!
  522.  
  523.  
  524. !Window methodsFor: 'mode attaching'!
  525.  
  526. attachModeTo: aMode absAt: p extent: e 
  527.     "Also attach the shrunkenWindow.  Shan August 4, 1989"
  528.  
  529.     super attachModeTo: aMode absAt: p extent: e.
  530.     self attachShrunkenWindowTo: aMode  "Shan 13 June 1990"!
  531.  
  532. attachModeTo: aMode at: p extent: e 
  533.     "Also attach the shrunkenWindow.  Shan August 4, 1989"
  534.  
  535.     super attachModeTo: aMode at: p extent: e.
  536.     self attachShrunkenWindowTo: aMode  "Shan 13 June 1990"!
  537.  
  538. attachShrunkenWindowTo: aMode
  539.     "Also attach the shrunkenWindow.  Shan 13 June 1990"
  540.  
  541.     shrunkenWindow attachModeTo: aMode! !
  542.  
  543. !Window methodsFor: 'expand-shrink'!
  544.  
  545. initialClose
  546.     "The window will initially be open.  Do nothing since this is the 
  547.     default. Shan August 4, 1989"
  548.  
  549.     ^self!
  550.  
  551. initialOpen
  552.     "The window will initially be open.  Shan August 4, 1989"
  553.  
  554.     mode map.
  555.     shrunkenWindow mode unMap!
  556.  
  557. shrink
  558.     "This method close the window into an icon.  Shan June 7, 1989"
  559.  
  560.     titleBar mode deHighlight. "Shan July 21, 1989"
  561.     mode eraseAndUnMap.
  562.     "shrunkenWindow mode superView isNil ifTrue: [mode superView addSubMode: shrunkenWindow mode at: 50 @ 50]. Shan June 15 commented out"
  563.     Display zoom: mode unclippedDisplayBox to: shrunkenWindow mode unclippedDisplayBox.
  564.     shrunkenWindow mode mapAndDisplay!
  565.  
  566. shrinkPosition: aPoint 
  567.     "Shan June 16, 1989"
  568.  
  569.     shrunkenWindow mode origin: aPoint! !
  570.  
  571. !Window methodsFor: 'access'!
  572.  
  573. shrunkenWindow
  574.     ^shrunkenWindow!
  575.  
  576. shrunkenWindow: w
  577.     shrunkenWindow _ w!
  578.  
  579. title
  580.     "Shan 30 May 1990"
  581.  
  582.     title isNil ifTrue: [title _ ''].
  583.     ^title!
  584.  
  585. title: aString
  586.     "Change the title.  Shan 30 May 1990"
  587.     title _ aString.
  588.     self setUpTitleBar.
  589.     self setUpShrunkenWindow!
  590.  
  591. titleBar: aTitleBar 
  592.     "Shan September 5, 1989"
  593.  
  594.     titleBar isNil
  595.         ifFalse: 
  596.             [titleBar mode removeFromSuperMode.
  597.             titleBar mode release].
  598.     titleBar _ aTitleBar title: self title.
  599.     titleBar attachTo: self.
  600.     titleBar mode moveToBack! !
  601.  
  602. !Window methodsFor: 'application mode'!
  603.  
  604. applicationMode
  605.     ^applicationMode!
  606.  
  607. applicationMode: applMode
  608.     | rs |  
  609.     applicationMode _ applMode.
  610.     mode
  611.         addToBackSubMode: applMode
  612.         at: mode borderWidth @ 28
  613.         extent: mode window extent - (0 @ 26) - (2*mode borderWidth).
  614.     applicationMode borderWidth: 0.
  615.     rs _ ResizeStyle new.  "Shan June 23, 1989"
  616.     rs originX: #fixed.
  617.     rs originY: #fixed.
  618.     rs cornerX: #fixed.
  619.     rs cornerY: #fixed.
  620.     rs matchViewportWindow: true.
  621.     applicationMode resizeStyle: rs.! !
  622.  
  623. !Window methodsFor: 'positioning'!
  624.  
  625. move
  626.     mode controller moveImage! !
  627.  
  628. !Window methodsFor: 'setUps'!
  629.  
  630. setUpResizeBox
  631.     "Shan 15 May 1990"
  632.  
  633.     | rBox |
  634.     rBox _ ResizeBox client: self.
  635.     rBox attachModeTo: mode at: mode window extent - (18 @ 18)!
  636.  
  637. setUpShrinkBox
  638.     "Shan  June 7, 1989"
  639.  
  640.     ShrinkBox client: self!
  641.  
  642. setUpShrunkenWindow
  643.     "Shan 30 May 1990"
  644.  
  645.     | pos superM |
  646.     shrunkenWindow isNil
  647.         ifFalse: 
  648.             [superM _ shrunkenWindow mode superMode.    "Shan 1 June 1990"
  649.             pos _ shrunkenWindow mode origin.
  650.             shrunkenWindow mode superView isNil ifFalse: ["Come back and fix it. shrunkenW not refreshed."
  651.                 (shrunkenWindow mode) map; erase].    "2 June 1990: des added the isNil check"
  652.             shrunkenWindow mode removeFromSuperMode.
  653.             shrunkenWindow mode release].
  654.     shrunkenWindow _ ShrunkenWindow window: self.
  655.     pos isNil | superM isNil
  656.         ifTrue: ["2 June 1990: des added the superM check"
  657.             shrunkenWindow mode origin: 50 @ 150]
  658.         ifFalse: [shrunkenWindow attachModeTo: superM at: pos]!
  659.  
  660. setUpTitleBar
  661.     "Shan 30 May 1990"
  662.  
  663.     self titleBar: TitleBar new.
  664.     mode superMode isNil ifFalse: [self mode display]! !
  665.  
  666. !Window methodsFor: 'controller-msg'!
  667.  
  668. enterWindow: e 
  669.     "Tell the title bar to highlight.  Shan July 21, 1989"
  670.  
  671.     titleBar mode highlight!
  672.  
  673. leaveWindow: e 
  674.     "Tell the title bar to deHighlight.  Shan July 21, 1989"
  675.  
  676.     titleBar mode deHighlight! !
  677.  
  678. !Window methodsFor: 'MMS-initializations'!
  679.  
  680. setUpAppearance
  681.     "Shan June 6, 1989"
  682.  
  683.     super setUpAppearance.  "Shan July 21, 1989"
  684.     mode borderWidth: 2.
  685.     mode insideColor: Form white!
  686.  
  687. setUpController
  688.     "Very important!!  The controllers of a window must be opaque.    
  689.     Otherwise, unprocessed events will be sent to the window under it.   
  690.     Shan June 6, 1989"
  691.     "Add the highlight when enter window.  Shan July 21, 1989"
  692.  
  693.     | ctrl erDict |
  694.     super setUpController.
  695.     ctrl _ mode controller.
  696.     erDict _ ctrl eventResponses deepCopy.
  697.     erDict at: #enterMode put: #enterWindow:.
  698.     erDict at: #leaveMode put: #leaveWindow:.
  699.     ctrl eventResponses: erDict! !
  700.  
  701. !Window methodsFor: 'initialize-release'!
  702.  
  703. initialize
  704.     "Shan June 7, 1989"
  705.  
  706.     super initialize.
  707.     minimumSize _ 50 @ 50.
  708.     maximumSize _ Display extent.
  709.     "Default initial state is shrunken"
  710.     mode unMap.
  711.     self setUpTitleBar. "Shan 30 May 1990"
  712.     self setUpShrinkBox.
  713.     self setUpResizeBox.
  714.     self setUpShrunkenWindow! !
  715.  
  716. !Window methodsFor: 'private'!
  717.  
  718. title: t origin: org extent: ext 
  719.     "Shan June 6, 1989"
  720.  
  721.     self title: t.
  722.     mode origin: org extent: ext.
  723.     "self setUpTitleBar.
  724.     self setUpShrinkBox.
  725.     self setUpResizeBox.
  726.     self setUpShrunkenWindow  Shan 30 May 1990"! !
  727.  
  728. !Window methodsFor: 'size'!
  729.  
  730. maximumSize
  731.     "Answer a point representing the maximum width and height of the receiver."
  732.     ^maximumSize!
  733.  
  734. maximumSize: aPoint 
  735.     "Set the argument, aPoint, to be the maximum width and height of the receiver."
  736.     maximumSize _ aPoint!
  737.  
  738. minimumSize
  739.     "Answer a point representing the minimum width and height of the receiver."
  740.     ^minimumSize!
  741.  
  742. minimumSize: aPoint 
  743.     "Set the argument, aPoint, to be the minimum width and height of the receiver."
  744.     minimumSize _ aPoint! !
  745.  
  746. !Window methodsFor: 'roaming'!
  747.  
  748. addHorizontalScrollBar
  749.     "Assume that applicationMode exists.  Shan June 23, 1989"
  750.  
  751.     | sBar wind rs |
  752.     wind _ mode window.
  753.     sBar _ RoamBox extent: wind width - 16 @ 18 clientMode: applicationMode.
  754.     sBar attachModeTo: mode at: 0 @ (wind bottom - sBar mode viewport height).
  755.     rs _ ResizeStyle new.
  756.     rs originX: #fixed.
  757.     rs extentY: #fixed.
  758.     rs cornerX: #fixed.
  759.     rs cornerY: #fixed.
  760.     sBar mode resizeStyle: rs.
  761.     applicationMode extent: applicationMode viewport extent - (0 @ (sBar mode viewport height -2))!
  762.  
  763. addVerticalScrollBar
  764.     "Assume that applicationMode exists.  Shan June 23, 1989"
  765.  
  766.     | sBar wind rs |
  767.     wind _ mode window.
  768.     sBar _ RoamBox extent: 18 @ (wind height - 16 - 26) clientMode: applicationMode.
  769.     sBar attachModeTo: mode at: wind right - sBar mode viewport width @ (wind top + 26).
  770.     rs _ ResizeStyle new.
  771.     rs originY: #fixed.
  772.     rs extentX: #fixed.
  773.     rs cornerX: #fixed.
  774.     rs cornerY: #fixed.
  775.     sBar mode resizeStyle: rs.
  776.     applicationMode extent: applicationMode viewport extent - (sBar mode viewport width - 2 @ 0)! !
  777.  
  778. !Window methodsFor: 'copying'!
  779.  
  780. duplicate
  781.     "Detach the icon of the window from rootMode. Shan September 5, 
  782.     1989"
  783.  
  784.     | c |
  785.     shrunkenWindow isNil ifTrue: [^super duplicate].    "Shan 13 June 1990"
  786.     shrunkenWindow mode removeFromSuperMode.
  787.     c _ super duplicate.
  788.     mode superMode notNil ifTrue: [shrunkenWindow attachModeTo: mode superMode].
  789.     ^c! !
  790. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  791.  
  792. Window class
  793.     instanceVariableNames: ''!
  794.  
  795.  
  796. !Window class methodsFor: 'instance creation'!
  797.  
  798. title: title
  799.     "Return a window with titlebar.  Shan June 6, 1989"
  800.  
  801.     ^self title: title extent: 300@300!
  802.  
  803. title: title extent: ext 
  804.     "Return a window with titlebar.  Shan June 6, 1989"
  805.  
  806.     ^self title: title origin: 50@50 extent: ext!
  807.  
  808. title: title origin: org extent: ext 
  809.     "Return a window with titlebar.  Shan June 16, 1989"
  810.  
  811.     ^self new title: title origin: org extent: ext! !
  812.  
  813. !Window class methodsFor: 'testing'!
  814.  
  815. netTest
  816.     "Window netTest"
  817.     "Shan June 7, 1989"
  818.  
  819.     | rMode w|
  820.     rMode _ RootMode new.
  821.     w _ Window title: 'Test Window' origin: 50@50 extent: 400 @ 400.
  822.     w shrinkPosition: 5@5.
  823.     w attachModeTo: rMode.
  824.     w applicationMode: Net new mode.
  825.     "Scrollbar must come after the application is set.  Shan June 23, 1989"
  826.     w addVerticalScrollBar.
  827.     w addHorizontalScrollBar.
  828.     rMode startUp!
  829.  
  830. shadedTitleBarTest
  831.     "Window shadedTitleBarTest"
  832.     "Shan June 6, 1989"
  833.  
  834.     | rMode w |
  835.     rMode _ RootMode new.
  836.     w _ Window title: 'Test Window' extent: 200 @ 200.
  837.     w attachModeTo: rMode at: 50 @ 50.
  838.     w shrunkenWindow attachModeTo: rMode at: 5 @ 5.
  839.     w initialOpen.
  840.     w titleBar: ShadedTitleBar new.
  841.     rMode startUp!
  842.  
  843. vanillaTest
  844.     "Window vanillaTest"
  845.     "Shan June 6, 1989"
  846.  
  847.     | rMode w |
  848.     rMode _ RootMode new.
  849.     w _ Window title: 'Test Window' extent: 200 @ 200.
  850.     w attachModeTo: rMode at: 50 @ 50.
  851.     w shrunkenWindow attachModeTo: rMode at: 5 @ 5.
  852.     w initialOpen.
  853.     rMode startUp! !